home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Pod / ParseUtils.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  20.4 KB  |  855 lines
  1. #############################################################################
  2. # Pod/ParseUtils.pm -- helpers for POD parsing and conversion
  3. #
  4. # Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved.
  5. # This file is part of "PodParser". PodParser is free software;
  6. # you can redistribute it and/or modify it under the same terms
  7. # as Perl itself.
  8. #############################################################################
  9.  
  10. package Pod::ParseUtils;
  11.  
  12. use vars qw($VERSION);
  13. $VERSION = 1.35;   ## Current version of this package
  14. require  5.005;    ## requires this Perl version or later
  15.  
  16. =head1 NAME
  17.  
  18. Pod::ParseUtils - helpers for POD parsing and conversion
  19.  
  20. =head1 SYNOPSIS
  21.  
  22.   use Pod::ParseUtils;
  23.  
  24.   my $list = new Pod::List;
  25.   my $link = Pod::Hyperlink->new('Pod::Parser');
  26.  
  27. =head1 DESCRIPTION
  28.  
  29. B<Pod::ParseUtils> contains a few object-oriented helper packages for
  30. POD parsing and processing (i.e. in POD formatters and translators).
  31.  
  32. =cut
  33.  
  34. #-----------------------------------------------------------------------------
  35. # Pod::List
  36. #
  37. # class to hold POD list info (=over, =item, =back)
  38. #-----------------------------------------------------------------------------
  39.  
  40. package Pod::List;
  41.  
  42. use Carp;
  43.  
  44. =head2 Pod::List
  45.  
  46. B<Pod::List> can be used to hold information about POD lists
  47. (written as =over ... =item ... =back) for further processing.
  48. The following methods are available:
  49.  
  50. =over 4
  51.  
  52. =item Pod::List-E<gt>new()
  53.  
  54. Create a new list object. Properties may be specified through a hash
  55. reference like this:
  56.  
  57.   my $list = Pod::List->new({ -start => $., -indent => 4 });
  58.  
  59. See the individual methods/properties for details.
  60.  
  61. =cut
  62.  
  63. sub new {
  64.     my $this = shift;
  65.     my $class = ref($this) || $this;
  66.     my %params = @_;
  67.     my $self = {%params};
  68.     bless $self, $class;
  69.     $self->initialize();
  70.     return $self;
  71. }
  72.  
  73. sub initialize {
  74.     my $self = shift;
  75.     $self->{-file} ||= 'unknown';
  76.     $self->{-start} ||= 'unknown';
  77.     $self->{-indent} ||= 4; # perlpod: "should be the default"
  78.     $self->{_items} = [];
  79.     $self->{-type} ||= '';
  80. }
  81.  
  82. =item $list-E<gt>file()
  83.  
  84. Without argument, retrieves the file name the list is in. This must
  85. have been set before by either specifying B<-file> in the B<new()>
  86. method or by calling the B<file()> method with a scalar argument.
  87.  
  88. =cut
  89.  
  90. # The POD file name the list appears in
  91. sub file {
  92.    return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
  93. }
  94.  
  95. =item $list-E<gt>start()
  96.  
  97. Without argument, retrieves the line number where the list started.
  98. This must have been set before by either specifying B<-start> in the
  99. B<new()> method or by calling the B<start()> method with a scalar
  100. argument.
  101.  
  102. =cut
  103.  
  104. # The line in the file the node appears
  105. sub start {
  106.    return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
  107. }
  108.  
  109. =item $list-E<gt>indent()
  110.  
  111. Without argument, retrieves the indent level of the list as specified
  112. in C<=over n>. This must have been set before by either specifying
  113. B<-indent> in the B<new()> method or by calling the B<indent()> method
  114. with a scalar argument.
  115.  
  116. =cut
  117.  
  118. # indent level
  119. sub indent {
  120.    return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
  121. }
  122.  
  123. =item $list-E<gt>type()
  124.  
  125. Without argument, retrieves the list type, which can be an arbitrary value,
  126. e.g. C<OL>, C<UL>, ... when thinking the HTML way.
  127. This must have been set before by either specifying
  128. B<-type> in the B<new()> method or by calling the B<type()> method
  129. with a scalar argument.
  130.  
  131. =cut
  132.  
  133. # The type of the list (UL, OL, ...)
  134. sub type {
  135.    return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
  136. }
  137.  
  138. =item $list-E<gt>rx()
  139.  
  140. Without argument, retrieves a regular expression for simplifying the 
  141. individual item strings once the list type has been determined. Usage:
  142. E.g. when converting to HTML, one might strip the leading number in
  143. an ordered list as C<E<lt>OLE<gt>> already prints numbers itself.
  144. This must have been set before by either specifying
  145. B<-rx> in the B<new()> method or by calling the B<rx()> method
  146. with a scalar argument.
  147.  
  148. =cut
  149.  
  150. # The regular expression to simplify the items
  151. sub rx {
  152.    return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};
  153. }
  154.  
  155. =item $list-E<gt>item()
  156.  
  157. Without argument, retrieves the array of the items in this list.
  158. The items may be represented by any scalar.
  159. If an argument has been given, it is pushed on the list of items.
  160.  
  161. =cut
  162.  
  163. # The individual =items of this list
  164. sub item {
  165.     my ($self,$item) = @_;
  166.     if(defined $item) {
  167.         push(@{$self->{_items}}, $item);
  168.         return $item;
  169.     }
  170.     else {
  171.         return @{$self->{_items}};
  172.     }
  173. }
  174.  
  175. =item $list-E<gt>parent()
  176.  
  177. Without argument, retrieves information about the parent holding this
  178. list, which is represented as an arbitrary scalar.
  179. This must have been set before by either specifying
  180. B<-parent> in the B<new()> method or by calling the B<parent()> method
  181. with a scalar argument.
  182.  
  183. =cut
  184.  
  185. # possibility for parsers/translators to store information about the
  186. # lists's parent object
  187. sub parent {
  188.    return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};
  189. }
  190.  
  191. =item $list-E<gt>tag()
  192.  
  193. Without argument, retrieves information about the list tag, which can be
  194. any scalar.
  195. This must have been set before by either specifying
  196. B<-tag> in the B<new()> method or by calling the B<tag()> method
  197. with a scalar argument.
  198.  
  199. =back
  200.  
  201. =cut
  202.  
  203. # possibility for parsers/translators to store information about the
  204. # list's object
  205. sub tag {
  206.    return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};
  207. }
  208.  
  209. #-----------------------------------------------------------------------------
  210. # Pod::Hyperlink
  211. #
  212. # class to manipulate POD hyperlinks (L<>)
  213. #-----------------------------------------------------------------------------
  214.  
  215. package Pod::Hyperlink;
  216.  
  217. =head2 Pod::Hyperlink
  218.  
  219. B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage:
  220.  
  221.   my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');
  222.  
  223. The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
  224. C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
  225. different parts of a POD hyperlink for further processing. It can also be
  226. used to construct hyperlinks.
  227.  
  228. =over 4
  229.  
  230. =item Pod::Hyperlink-E<gt>new()
  231.  
  232. The B<new()> method can either be passed a set of key/value pairs or a single
  233. scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
  234. of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
  235. failure, the error message is stored in C<$@>.
  236.  
  237. =cut
  238.  
  239. use Carp;
  240.  
  241. sub new {
  242.     my $this = shift;
  243.     my $class = ref($this) || $this;
  244.     my $self = +{};
  245.     bless $self, $class;
  246.     $self->initialize();
  247.     if(defined $_[0]) {
  248.         if(ref($_[0])) {
  249.             # called with a list of parameters
  250.             %$self = %{$_[0]};
  251.             $self->_construct_text();
  252.         }
  253.         else {
  254.             # called with L<> contents
  255.             return undef unless($self->parse($_[0]));
  256.         }
  257.     }
  258.     return $self;
  259. }
  260.  
  261. sub initialize {
  262.     my $self = shift;
  263.     $self->{-line} ||= 'undef';
  264.     $self->{-file} ||= 'undef';
  265.     $self->{-page} ||= '';
  266.     $self->{-node} ||= '';
  267.     $self->{-alttext} ||= '';
  268.     $self->{-type} ||= 'undef';
  269.     $self->{_warnings} = [];
  270. }
  271.  
  272. =item $link-E<gt>parse($string)
  273.  
  274. This method can be used to (re)parse a (new) hyperlink, i.e. the contents
  275. of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.
  276. Warnings are stored in the B<warnings> property.
  277. E.g. sections like C<LE<lt>open(2)E<gt>> are deprecated, as they do not point
  278. to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage
  279. section can simply be dropped.
  280.  
  281. =cut
  282.  
  283. sub parse {
  284.     my $self = shift;
  285.     local($_) = $_[0];
  286.     # syntax check the link and extract destination
  287.     my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0);
  288.  
  289.     $self->{_warnings} = [];
  290.  
  291.     # collapse newlines with whitespace
  292.     s/\s*\n+\s*/ /g;
  293.  
  294.     # strip leading/trailing whitespace
  295.     if(s/^[\s\n]+//) {
  296.         $self->warning("ignoring leading whitespace in link");
  297.     }
  298.     if(s/[\s\n]+$//) {
  299.         $self->warning("ignoring trailing whitespace in link");
  300.     }
  301.     unless(length($_)) {
  302.         _invalid_link("empty link");
  303.         return undef;
  304.     }
  305.  
  306.     ## Check for different possibilities. This is tedious and error-prone
  307.     # we match all possibilities (alttext, page, section/item)
  308.     #warn "DEBUG: link=$_\n";
  309.  
  310.     # only page
  311.     # problem: a lot of people use (), or (1) or the like to indicate
  312.     # man page sections. But this collides with L<func()> that is supposed
  313.     # to point to an internal funtion...
  314.     my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)';
  315.     # page name only
  316.     if(m!^($page_rx)$!o) {
  317.         $page = $1;
  318.         $type = 'page';
  319.     }
  320.     # alttext, page and "section"
  321.     elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$!o) {
  322.         ($alttext, $page, $node) = ($1, $2, $3);
  323.         $type = 'section';
  324.         $quoted = 1; #... therefore | and / are allowed
  325.     }
  326.     # alttext and page
  327.     elsif(m!^(.*?)\s*[|]\s*($page_rx)$!o) {
  328.         ($alttext, $page) = ($1, $2);
  329.         $type = 'page';
  330.     }
  331.     # alttext and "section"
  332.     elsif(m!^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$!) {
  333.         ($alttext, $node) = ($1,$2);
  334.         $type = 'section';
  335.         $quoted = 1;
  336.     }
  337.     # page and "section"
  338.     elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) {
  339.         ($page, $node) = ($1, $2);
  340.         $type = 'section';
  341.         $quoted = 1;
  342.     }
  343.     # page and item
  344.     elsif(m!^($page_rx)\s*/\s*(.+)$!o) {
  345.         ($page, $node) = ($1, $2);
  346.         $type = 'item';
  347.     }
  348.     # only "section"
  349.     elsif(m!^/?"(.+)"$!) {
  350.         $node = $1;
  351.         $type = 'section';
  352.         $quoted = 1;
  353.     }
  354.     # only item
  355.     elsif(m!^\s*/(.+)$!) {
  356.         $node = $1;
  357.         $type = 'item';
  358.     }
  359.  
  360.     # non-standard: Hyperlink with alt-text - doesn't remove protocol prefix, maybe it should?
  361.     elsif(m!^ \s* (.*?) \s* [|] \s* (\w+:[^:\s] [^\s|]*?) \s* $!ix) {
  362.       ($alttext,$node) = ($1,$2);
  363.       $type = 'hyperlink';
  364.     }
  365.  
  366.     # non-standard: Hyperlink
  367.     elsif(m!^(\w+:[^:\s]\S*)$!i) {
  368.         $node = $1;
  369.         $type = 'hyperlink';
  370.     }
  371.     # alttext, page and item
  372.     elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$!o) {
  373.         ($alttext, $page, $node) = ($1, $2, $3);
  374.         $type = 'item';
  375.     }
  376.     # alttext and item
  377.     elsif(m!^(.*?)\s*[|]\s*/(.+)$!) {
  378.         ($alttext, $node) = ($1,$2);
  379.     }
  380.     # must be an item or a "malformed" section (without "")
  381.     else {
  382.         $node = $_;
  383.         $type = 'item';
  384.     }
  385.     # collapse whitespace in nodes
  386.     $node =~ s/\s+/ /gs;
  387.  
  388.     # empty alternative text expands to node name
  389.     if(defined $alttext) {
  390.         if(!length($alttext)) {
  391.           $alttext = $node | $page;
  392.         }
  393.     }
  394.     else {
  395.         $alttext = '';
  396.     }
  397.  
  398.     if($page =~ /[(]\w*[)]$/) {
  399.         $self->warning("(section) in '$page' deprecated");
  400.     }
  401.     if(!$quoted && $node =~ m:[|/]: && $type ne 'hyperlink') {
  402.         $self->warning("node '$node' contains non-escaped | or /");
  403.     }
  404.     if($alttext =~ m:[|/]:) {
  405.         $self->warning("alternative text '$node' contains non-escaped | or /");
  406.     }
  407.     $self->{-page} = $page;
  408.     $self->{-node} = $node;
  409.     $self->{-alttext} = $alttext;
  410.     #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";
  411.     $self->{-type} = $type;
  412.     $self->_construct_text();
  413.     1;
  414. }
  415.  
  416. sub _construct_text {
  417.     my $self = shift;
  418.     my $alttext = $self->alttext();
  419.     my $type = $self->type();
  420.     my $section = $self->node();
  421.     my $page = $self->page();
  422.     my $page_ext = '';
  423.     $page =~ s/([(]\w*[)])$// && ($page_ext = $1);
  424.     if($alttext) {
  425.         $self->{_text} = $alttext;
  426.     }
  427.     elsif($type eq 'hyperlink') {
  428.         $self->{_text} = $section;
  429.     }
  430.     else {
  431.         $self->{_text} = ($section || '') .
  432.             (($page && $section) ? ' in ' : '') .
  433.             "$page$page_ext";
  434.     }
  435.     # for being marked up later
  436.     # use the non-standard markers P<> and Q<>, so that the resulting
  437.     # text can be parsed by the translators. It's their job to put
  438.     # the correct hypertext around the linktext
  439.     if($alttext) {
  440.         $self->{_markup} = "Q<$alttext>";
  441.     }
  442.     elsif($type eq 'hyperlink') {
  443.         $self->{_markup} = "Q<$section>";
  444.     }
  445.     else {
  446.         $self->{_markup} = (!$section ? '' : "Q<$section>") .
  447.             ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : '');
  448.     }
  449. }
  450.  
  451. =item $link-E<gt>markup($string)
  452.  
  453. Set/retrieve the textual value of the link. This string contains special
  454. markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the
  455. translator's interior sequence expansion engine to the
  456. formatter-specific code to highlight/activate the hyperlink. The details
  457. have to be implemented in the translator.
  458.  
  459. =cut
  460.  
  461. #' retrieve/set markuped text
  462. sub markup {
  463.     return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};
  464. }
  465.  
  466. =item $link-E<gt>text()
  467.  
  468. This method returns the textual representation of the hyperlink as above,
  469. but without markers (read only). Depending on the link type this is one of
  470. the following alternatives (the + and * denote the portions of the text
  471. that are marked up):
  472.  
  473.   +perl+                    L<perl>
  474.   *$|* in +perlvar+         L<perlvar/$|>
  475.   *OPTIONS* in +perldoc+    L<perldoc/"OPTIONS">
  476.   *DESCRIPTION*             L<"DESCRIPTION">
  477.  
  478. =cut
  479.  
  480. # The complete link's text
  481. sub text {
  482.     $_[0]->{_text};
  483. }
  484.  
  485. =item $link-E<gt>warning()
  486.  
  487. After parsing, this method returns any warnings encountered during the
  488. parsing process.
  489.  
  490. =cut
  491.  
  492. # Set/retrieve warnings
  493. sub warning {
  494.     my $self = shift;
  495.     if(@_) {
  496.         push(@{$self->{_warnings}}, @_);
  497.         return @_;
  498.     }
  499.     return @{$self->{_warnings}};
  500. }
  501.  
  502. =item $link-E<gt>file()
  503.  
  504. =item $link-E<gt>line()
  505.  
  506. Just simple slots for storing information about the line and the file
  507. the link was encountered in. Has to be filled in manually.
  508.  
  509. =cut
  510.  
  511. # The line in the file the link appears
  512. sub line {
  513.     return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
  514. }
  515.  
  516. # The POD file name the link appears in
  517. sub file {
  518.     return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
  519. }
  520.  
  521. =item $link-E<gt>page()
  522.  
  523. This method sets or returns the POD page this link points to.
  524.  
  525. =cut
  526.  
  527. # The POD page the link appears on
  528. sub page {
  529.     if (@_ > 1) {
  530.         $_[0]->{-page} = $_[1];
  531.         $_[0]->_construct_text();
  532.     }
  533.     $_[0]->{-page};
  534. }
  535.  
  536. =item $link-E<gt>node()
  537.  
  538. As above, but the destination node text of the link.
  539.  
  540. =cut
  541.  
  542. # The link destination
  543. sub node {
  544.     if (@_ > 1) {
  545.         $_[0]->{-node} = $_[1];
  546.         $_[0]->_construct_text();
  547.     }
  548.     $_[0]->{-node};
  549. }
  550.  
  551. =item $link-E<gt>alttext()
  552.  
  553. Sets or returns an alternative text specified in the link.
  554.  
  555. =cut
  556.  
  557. # Potential alternative text
  558. sub alttext {
  559.     if (@_ > 1) {
  560.         $_[0]->{-alttext} = $_[1];
  561.         $_[0]->_construct_text();
  562.     }
  563.     $_[0]->{-alttext};
  564. }
  565.  
  566. =item $link-E<gt>type()
  567.  
  568. The node type, either C<section> or C<item>. As an unofficial type,
  569. there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>>
  570.  
  571. =cut
  572.  
  573. # The type: item or headn
  574. sub type {
  575.     return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
  576. }
  577.  
  578. =item $link-E<gt>link()
  579.  
  580. Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>.
  581.  
  582. =back
  583.  
  584. =cut
  585.  
  586. # The link itself
  587. sub link {
  588.     my $self = shift;
  589.     my $link = $self->page() || '';
  590.     if($self->node()) {
  591.         my $node = $self->node();
  592.         $text =~ s/\|/E<verbar>/g;
  593.         $text =~ s:/:E<sol>:g;
  594.         if($self->type() eq 'section') {
  595.             $link .= ($link ? '/' : '') . '"' . $node . '"';
  596.         }
  597.         elsif($self->type() eq 'hyperlink') {
  598.             $link = $self->node();
  599.         }
  600.         else { # item
  601.             $link .= '/' . $node;
  602.         }
  603.     }
  604.     if($self->alttext()) {
  605.         my $text = $self->alttext();
  606.         $text =~ s/\|/E<verbar>/g;
  607.         $text =~ s:/:E<sol>:g;
  608.         $link = "$text|$link";
  609.     }
  610.     $link;
  611. }
  612.  
  613. sub _invalid_link {
  614.     my ($msg) = @_;
  615.     # this sets @_
  616.     #eval { die "$msg\n" };
  617.     #chomp $@;
  618.     $@ = $msg; # this seems to work, too!
  619.     undef;
  620. }
  621.  
  622. #-----------------------------------------------------------------------------
  623. # Pod::Cache
  624. #
  625. # class to hold POD page details
  626. #-----------------------------------------------------------------------------
  627.  
  628. package Pod::Cache;
  629.  
  630. =head2 Pod::Cache
  631.  
  632. B<Pod::Cache> holds information about a set of POD documents,
  633. especially the nodes for hyperlinks.
  634. The following methods are available:
  635.  
  636. =over 4
  637.  
  638. =item Pod::Cache-E<gt>new()
  639.  
  640. Create a new cache object. This object can hold an arbitrary number of
  641. POD documents of class Pod::Cache::Item.
  642.  
  643. =cut
  644.  
  645. sub new {
  646.     my $this = shift;
  647.     my $class = ref($this) || $this;
  648.     my $self = [];
  649.     bless $self, $class;
  650.     return $self;
  651. }
  652.  
  653. =item $cache-E<gt>item()
  654.  
  655. Add a new item to the cache. Without arguments, this method returns a
  656. list of all cache elements.
  657.  
  658. =cut
  659.  
  660. sub item {
  661.     my ($self,%param) = @_;
  662.     if(%param) {
  663.         my $item = Pod::Cache::Item->new(%param);
  664.         push(@$self, $item);
  665.         return $item;
  666.     }
  667.     else {
  668.         return @{$self};
  669.     }
  670. }
  671.  
  672. =item $cache-E<gt>find_page($name)
  673.  
  674. Look for a POD document named C<$name> in the cache. Returns the
  675. reference to the corresponding Pod::Cache::Item object or undef if
  676. not found.
  677.  
  678. =back
  679.  
  680. =cut
  681.  
  682. sub find_page {
  683.     my ($self,$page) = @_;
  684.     foreach(@$self) {
  685.         if($_->page() eq $page) {
  686.             return $_;
  687.         }
  688.     }
  689.     undef;
  690. }
  691.  
  692. package Pod::Cache::Item;
  693.  
  694. =head2 Pod::Cache::Item
  695.  
  696. B<Pod::Cache::Item> holds information about individual POD documents,
  697. that can be grouped in a Pod::Cache object.
  698. It is intended to hold information about the hyperlink nodes of POD
  699. documents.
  700. The following methods are available:
  701.  
  702. =over 4
  703.  
  704. =item Pod::Cache::Item-E<gt>new()
  705.  
  706. Create a new object.
  707.  
  708. =cut
  709.  
  710. sub new {
  711.     my $this = shift;
  712.     my $class = ref($this) || $this;
  713.     my %params = @_;
  714.     my $self = {%params};
  715.     bless $self, $class;
  716.     $self->initialize();
  717.     return $self;
  718. }
  719.  
  720. sub initialize {
  721.     my $self = shift;
  722.     $self->{-nodes} = [] unless(defined $self->{-nodes});
  723. }
  724.  
  725. =item $cacheitem-E<gt>page()
  726.  
  727. Set/retrieve the POD document name (e.g. "Pod::Parser").
  728.  
  729. =cut
  730.  
  731. # The POD page
  732. sub page {
  733.    return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
  734. }
  735.  
  736. =item $cacheitem-E<gt>description()
  737.  
  738. Set/retrieve the POD short description as found in the C<=head1 NAME>
  739. section.
  740.  
  741. =cut
  742.  
  743. # The POD description, taken out of NAME if present
  744. sub description {
  745.    return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};
  746. }
  747.  
  748. =item $cacheitem-E<gt>path()
  749.  
  750. Set/retrieve the POD file storage path.
  751.  
  752. =cut
  753.  
  754. # The file path
  755. sub path {
  756.    return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};
  757. }
  758.  
  759. =item $cacheitem-E<gt>file()
  760.  
  761. Set/retrieve the POD file name.
  762.  
  763. =cut
  764.  
  765. # The POD file name
  766. sub file {
  767.    return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
  768. }
  769.  
  770. =item $cacheitem-E<gt>nodes()
  771.  
  772. Add a node (or a list of nodes) to the document's node list. Note that
  773. the order is kept, i.e. start with the first node and end with the last.
  774. If no argument is given, the current list of nodes is returned in the
  775. same order the nodes have been added.
  776. A node can be any scalar, but usually is a pair of node string and
  777. unique id for the C<find_node> method to work correctly.
  778.  
  779. =cut
  780.  
  781. # The POD nodes
  782. sub nodes {
  783.     my ($self,@nodes) = @_;
  784.     if(@nodes) {
  785.         push(@{$self->{-nodes}}, @nodes);
  786.         return @nodes;
  787.     }
  788.     else {
  789.         return @{$self->{-nodes}};
  790.     }
  791. }
  792.  
  793. =item $cacheitem-E<gt>find_node($name)
  794.  
  795. Look for a node or index entry named C<$name> in the object.
  796. Returns the unique id of the node (i.e. the second element of the array
  797. stored in the node array) or undef if not found.
  798.  
  799. =cut
  800.  
  801. sub find_node {
  802.     my ($self,$node) = @_;
  803.     my @search;
  804.     push(@search, @{$self->{-nodes}}) if($self->{-nodes});
  805.     push(@search, @{$self->{-idx}}) if($self->{-idx});
  806.     foreach(@search) {
  807.         if($_->[0] eq $node) {
  808.             return $_->[1]; # id
  809.         }
  810.     }
  811.     undef;
  812. }
  813.  
  814. =item $cacheitem-E<gt>idx()
  815.  
  816. Add an index entry (or a list of them) to the document's index list. Note that
  817. the order is kept, i.e. start with the first node and end with the last.
  818. If no argument is given, the current list of index entries is returned in the
  819. same order the entries have been added.
  820. An index entry can be any scalar, but usually is a pair of string and
  821. unique id.
  822.  
  823. =back
  824.  
  825. =cut
  826.  
  827. # The POD index entries
  828. sub idx {
  829.     my ($self,@idx) = @_;
  830.     if(@idx) {
  831.         push(@{$self->{-idx}}, @idx);
  832.         return @idx;
  833.     }
  834.     else {
  835.         return @{$self->{-idx}};
  836.     }
  837. }
  838.  
  839. =head1 AUTHOR
  840.  
  841. Please report bugs using L<http://rt.cpan.org>.
  842.  
  843. Marek Rouchal E<lt>marekr@cpan.orgE<gt>, borrowing
  844. a lot of things from L<pod2man> and L<pod2roff> as well as other POD
  845. processing tools by Tom Christiansen, Brad Appleton and Russ Allbery.
  846.  
  847. =head1 SEE ALSO
  848.  
  849. L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>,
  850. L<pod2html>
  851.  
  852. =cut
  853.  
  854. 1;
  855.